home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / ovrhan.com / OVERLAYH.PAS next >
Encoding:
Pascal/Delphi Source File  |  1990-01-09  |  16.0 KB  |  361 lines
  1. {****************************************************************************}
  2. {*                                                                          *}
  3. {*                 O V E R L A Y H . P A S - Overlay Handler                *}
  4. {*                                                                          *}
  5. {****************************************************************************}
  6.  
  7. {****************************************************************************}
  8. {*                                                                          *}
  9. {*                       Released to the public domain                      *}
  10. {*                                                                          *}
  11. {****************************************************************************}
  12.  
  13. {****************************************************************************
  14.  *      O V E R L A Y H . P A S    R E V I S I O N   H I S T O R Y
  15.  * $Revision:   1.0  $
  16.  * $Log:   D:/PASCAL/TURBO/SST/UI/VCS/OVERLAYH.PAV  $
  17.  * 
  18.  *    Rev 1.0   09 Jan 1990 17:21:58
  19.  * Initial revision.
  20.  * 
  21.  ****************************************************************************}
  22.  
  23. {****************************************************************************
  24.  *                                                            +-------------+
  25.  *  Author: Roy Furman [72346,72]                             | M O D U L E |
  26.  *  Date:   January, 1990                                     +-------------+
  27.  *
  28.  **************
  29.  * SYNOPSIS:    Handler to manage overlays loaded onto the heap.
  30.  *
  31.  * DESCRIPTION: This unit allows an application to control loading and
  32.  *  unloading of Turbo Pascal 5.5 overlays onto the standard heap rather than
  33.  *  into the overlay buffer managed by the Overlay unit supplied with Turbo
  34.  *  Pascal.  By allowing the program to explicitly load and unload overlays,
  35.  *  routines that normally would not be a candidate for an overlay can be
  36.  *  made into overlays and loaded when needed.  For instance, an application
  37.  *  with many time-critical hardware device drivers, only one, or a few, of
  38.  *  which will actually be used during program execution, normally must not
  39.  *  overlay the drivers to insure memory residency during interrupt service
  40.  *  calls.  These routines can now be made into overlays and selectively
  41.  *  loaded onto the heap during device initialization where they will remain
  42.  *  resident until explictly unloaded under program control.
  43.  *
  44.  *    To prepare a unit for overlaying onto the heap requires no special
  45.  *  considerations beyond those needed by the standard Overlay unit.  The
  46.  *  Overlay unit must be initialized by a call to OvrInit before any routines
  47.  *  in OverlayHandler are used.
  48.  *
  49.  *    Only two procedures are interfaced: LoadOverlay and UnloadOverlay.  Each
  50.  *  is supplied with an address parameter of any procedure or function that
  51.  *  is interfaced by the unit to overlay.  The address supplied is only used
  52.  *  to locate the overlay descriptor segment built by the compiler.  The unit
  53.  *  that contains the passed address will be loaded into the free space of
  54.  *  the heap.  Once loaded, it can be called freely.  The unit will remain
  55.  *  heap-resident until it is explicitly freed by an UnloadOverlay call.
  56.  *
  57.  *    An overlay unit on the heap will be ignored by Turbo's Overlay manager.
  58.  *  When the overlay unit is not on the heap, it will be managed by the Overlay
  59.  *  unit in the conventional fashion.  If a heap overlay is released that has
  60.  *  returns to one of its routines still pending in the stack, the stack will
  61.  *  be patched to enable Turbo's Overlay handler to reload the overlay into
  62.  *  the overlay buffer when the return occurs.  The heap space used by
  63.  *  Load/UnloadOverlay is otherwise exclusive of the overlay buffer space.
  64.  *  Both procedures return a result code in ovrLoadResult.
  65.  *
  66.  *    OverlayHandler.LoadOverlay works by first insuring that the requested
  67.  *  unit is an overlay and that it is not in memory, or will not be reloaded
  68.  *  into memory by an outstanding procedure/function return.  If sufficient
  69.  *  memory to load the overlay code, fixup table, and a 15 byte buffer exists,
  70.  *  then space is allocated on the heap and the overlay descriptor is patched
  71.  *  with the paragraph boundary to load the overlay.  The overlay is read into
  72.  *  the heap by calling OvrReadBuf in the Overlay unit.  If there are no errors,
  73.  *  the space required for the fixup table is released and the overlay
  74.  *  descriptor jump table is patched with "jmp far" instructions to the new
  75.  *  entry points.
  76.  *
  77.  *    OverlayHandler.UnloadOverlay first insures that the unit request was
  78.  *  loaded by LoadOverlay before it patches any outstanding stack returns to
  79.  *  return to the overlay descriptor jump table.  The jump table is then
  80.  *  changed from "jmp far" instructions to "int 3f" instructions and the
  81.  *  overlay is marked as unloaded.  The heap space allocated to the code is
  82.  *  then returned to the free list.
  83.  *
  84.  *
  85.  *  Limitations:
  86.  *
  87.  *    An overlay unit that is in Turbo's overlay buffer or that has stack
  88.  *  returns into the overlay pending cannot be loaded onto the heap.  In the
  89.  *  former case, call Overlay.OvrClearBuf to unload all units from the buffer,
  90.  *  and then call OverlayHandler.LoadOverlay to load onto the heap.
  91.  *
  92.  *    An overlay that requires more than 65521 bytes for code, the fixup table,
  93.  *  and a 15 byte overhead for paragraph alignment cannot be loaded because
  94.  *  the heap allocation routines do not allow a larger request.
  95.  *
  96.  *    The OverlayHandler unit, itself, may be an overlay, but it cannot load
  97.  *  itself onto the heap.  If it is attempted, an error will be returned.
  98.  *
  99.  *    These routines only work with Turbo Pascal 5.5.  The technique should
  100.  *  also work with version 5.0 as the overlay descriptor segments are similar,
  101.  *  but a work-alike replacement for the call Overlay.OvrReadBuf would need
  102.  *  to be developed.
  103.  ****************************************************************************}
  104.  
  105. {.$O+,F+}
  106. unit OverlayHandler;
  107. interface
  108. uses Overlay;
  109.  
  110. const
  111.   ovrLoadOk = 0;                       { Load/UnloadOverlay - no errors }
  112.   ovrLoadNotOverlay = -1;              { unit is not an overlay }
  113.   ovrLoadInUse = -2;                   { overlay is currently loaded }
  114.   ovrLoadWaitRet = -3;                 { stack return to overlay is pending }
  115.   ovrLoadSizeErr = -4;                 { overlay space request > 65521 bytes }
  116.   ovrLoadNoMemory = -5;                { requested space is not available }
  117.   ovrLoadReadErr = -6;                 { error reading overlay }
  118.   ovrLoadNotLoaded = -7;               { overlay is in memory already }
  119.   ovrLoadNotHeap = -8;                 { overlay loaded by Overlay unit }
  120.   ovrLoadSelfErr = -9;                 { cannot load OverlayHandler on heap }
  121.  
  122. var
  123.   ovrLoadResult : Integer;             { Result code for overlay request }
  124.  
  125.   procedure LoadOverlay (AnyRoutine : Pointer);
  126.     { Load an overlay onto the heap }
  127.   procedure UnloadOverlay (AnyRoutine : Pointer);
  128.     { Unload an overlay from the heap }
  129.  
  130. implementation
  131.  
  132. type
  133.   jumpVectors = record
  134.                   case Integer of
  135.                     1 : (instr : Byte; { jmp far addr if overlay loaded }
  136.                          addrs : Pointer);
  137.                     2 : (jmpfar : Byte;
  138.                          adrOfs : Word;
  139.                          adrSeg : Word);
  140.                     3 : (int3f : Word; { int 3f offset }
  141.                          offset : Word;{ offset of entry point }
  142.                          nul : Byte);
  143.                 end { jumpVectors } ;
  144.  
  145.   vectorTable = array [1..13097] of jumpVectors;
  146.  
  147.   OverlayNodePtr = ^OverlayNode;
  148.   OverlayNode = record                 { overlay descriptor record }
  149.                   OvrInst : Word;      { overlay interrupt }
  150.                   ovSaveReturn : Word; { offset into jump vector }
  151.                   ovFilePos : LongInt; { offset of overlay in OVR file }
  152.                   ovCodeSize : Word;   { size of code overlay }
  153.                   ovFixupSize : Word;  { size of relocation information }
  154.                   ovJmpCount : Word;   { # of entries in ovVectors }
  155.                   ovLink : Word;       { rel segment addr of next OvrCodeList }
  156.                   ovSegment : Word;    { current address of segment }
  157.                   ovRetryCount : Word; { 1 if overlay reprieved }
  158.                   ovNext : Word;       { abs segment addr for next OvrLoadList }
  159.                   ovEmsPage : Word;    { page address }
  160.                   ovEmsOffset : Word;  { offset within page }
  161.                   ovArea : Pointer;    { normally not used.  Heap area ptr }
  162.                   ovNotUsed : Word;
  163.                   ovVectors : vectorTable;
  164.                 end { OverLayNode } ;
  165.  
  166. var
  167.   OvrBP : Word;                        { stack frame ptr to start addr search }
  168.  
  169.   function PatchStackSegs(oldCS, newCS : Word) : Word;
  170.     { Probe the stack for return segment addresses equaling oldCS and replace
  171.       with newCS.  Return the frame pointer (BP) of the first segment address
  172.       replaced or return 0 if no active returns to oldCS were replaced. }
  173.   var bp, return : Word;
  174.   begin
  175.     return := 0;
  176.     bp := OvrBP;                       { point to top stack frame }
  177.     while bp <> 0 do begin             { 0 marks last stack frame }
  178.       if MemW[SSeg:bp+4] = oldCS then begin
  179.         MemW[SSeg:bp+4] := newCS;      { replace segment of return address }
  180.         if return = 0 then
  181.           return := bp;                { save frame pointer of 1st replacement }
  182.       end { if } ;
  183.       bp := MemW[SSeg:bp];             { link down to next stack frame }
  184.     end { while } ;
  185.     PatchStackSegs := return;          { return frame pointer, if any }
  186.   end { PatchStackSegs } ;
  187.  
  188.   function PatchStackFrames(oldCS, newCS, newIP : Word) : Word;
  189.     { Replace all stack return addresses with segments equaling oldCS with
  190.       newCS.  Replace the return address of the first stack frame
  191.       matching oldCS:xxxx with newCS:newIP.  Return the replaced oldIP or
  192.       return 0 if no active returns to oldCS are found }
  193.   var bp : Word;
  194.   begin
  195.     bp := PatchStackSegs(oldCS, newCS);{ patch return segment addresses }
  196.     if bp <> 0 then begin
  197.       PatchStackFrames := MemW[SSeg:bp+2];
  198.       MemW[SSeg:bp+2] := newIP;        { patch return offset address }
  199.     end { if }
  200.     else
  201.       PatchStackFrames := 0;
  202.   end { PatchStackFrames } ;
  203.  
  204.   procedure ovVectorReturn (OvrSeg : Word);
  205.     { Replace stack returns to ovSegment with returns to OvrSeg,
  206.       and replace first return to Overlay Manager by saving original ip.
  207.       Replace "jmp far" with "int 3f" in jump vector table. }
  208.   var
  209.     p : OverlayNodePtr;
  210.     i, temp : Word;
  211.   begin
  212.     p := Ptr(OvrSeg, 0);               { form overlay descriptor pointer }
  213.     p^.ovSaveReturn := PatchStackFrames(p^.ovSegment, OvrSeg, 0);
  214.     { Replace all jump vectors with traps to overlay manager }
  215.     for i := 1 to p^.ovJmpCount do
  216.       with p^.ovVectors[i] do begin
  217.         temp := adrOfs;                { save offset of routine's entry }
  218.         int3f := $3FCD;                { replace jmp far with int 3fh }
  219.         offset := temp;                { store entry offset }
  220.         nul := 0;                      { clear byte following }
  221.       end { with } ;
  222.   end { ovVectorReturn } ;
  223.  
  224.   procedure LinkovVectors (OvrSeg : Word);
  225.     { Link new entry points in ovVectors.
  226.       Convert int 3f/offset to jmp far ovSegment:offset entries. }
  227.   var
  228.     p : OverlayNodePtr;
  229.     i, temp, newSeg : Word;
  230.   begin
  231.     p := Ptr(OvrSeg, 0);               { form overlay descriptor pointer }
  232.     newSeg := p^.ovSegment;            { load address }
  233.     { Replace all traps to overlay manager with jmp far's }
  234.     for i := 1 to p^.ovJmpCount do
  235.       with p^.ovVectors[i] do begin
  236.         temp := offset;          { save offset of routine's entry }
  237.         instr := $EA;            { replace int 3fh with jmp far }
  238.         addrs := Ptr(newSeg, temp);
  239.       end { with } ;
  240.   end { LinkovVectors } ;
  241.  
  242.   function BPtr : Word;
  243.     { Return stack frame offset }
  244.   Inline($8B/$C5                       { mov ax,bp } );
  245.  
  246.  
  247.   { ----------------  P U B L I C  P R O C E D U R E S   -------------------- }
  248.  
  249.   procedure LoadOverlay (AnyRoutine : Pointer);
  250.     { Load an overlay onto the heap }
  251.   var
  252.     p : OverlayNodePtr;
  253.     spaceNeeded : LongInt;
  254.     pMemory : Pointer;
  255.   begin
  256.     p := Ptr(Seg(AnyRoutine^), 0);     { form overlay descriptor pointer }
  257.  
  258.     {$IFOPT O+}
  259.     if Seg(p^) = Seg(LoadOverlay) then begin
  260.       ovrLoadResult := ovrLoadSelfErr;
  261.       Exit;
  262.     end { if } ;
  263.     {$ENDIF}
  264.     if p^.ovrInst <> $3FCD then begin  { not an overlay descriptor }
  265.       ovrLoadResult := ovrLoadNotOverlay;
  266.       Exit;
  267.     end { if } ;
  268.     if (p^.ovSegment <> 0) or (p^.ovVectors[1].instr = $EA)then begin
  269.       ovrLoadResult := ovrLoadInUse;   { overlay is already in memory }
  270.       Exit;
  271.     end { if } ;
  272.     if p^.ovSaveReturn <> 0 then begin { waiting return to overlay }
  273.       ovrLoadResult := ovrLoadWaitRet;
  274.       Exit;
  275.     end { if } ;
  276.  
  277.     spaceNeeded := ((p^.ovCodeSize+15) shr 4 + (p^.ovFixupSize+15) shr 4) shl 4
  278.                    + 15;
  279.     if spaceNeeded > 65521 then begin  { requested space too large }
  280.       ovrLoadResult := ovrLoadSizeErr;
  281.       Exit;
  282.     end { if } ;
  283.     if spaceNeeded > MaxAvail then begin { requested memory not available }
  284.       ovrLoadResult := ovrLoadNoMemory;
  285.       Exit;
  286.     end { if } ;
  287.     GetMem(pMemory, spaceNeeded);      { request allocation }
  288.     if Ofs(pMemory^) = 0 then
  289.       p^.ovSegment := Seg(pMemory^)    { load at paragraph boundary }
  290.     else
  291.       p^.ovSegment := Seg(pMemory^)+1; { load at nearest paragraph boundary }
  292.  
  293.     if OvrReadBuf(Seg(p^)) <> 0 then begin { read overlay into memory }
  294.       FreeMem(pMemory, spaceNeeded);   { release overlay memory }
  295.       ovrLoadResult := ovrLoadReadErr; { overlay file read error }
  296.       Exit;
  297.     end { if } ;
  298.  
  299.     p^.ovArea := pMemory;              { save overlay load location }
  300.     if p^.ovFixupSize <> 0 then begin  { free fixup memory }
  301.       pMemory := Ptr(p^.ovSegment + (p^.ovCodeSize+15) shr 4, 0);
  302.       FreeMem(pMemory, ((p^.ovFixupSize+15) shr 4) shl 4 + 15-Ofs(p^.ovArea^));
  303.     end { if } ;
  304.  
  305.     LinkovVectors(Seg(p^));            { patch ovVectors }
  306.     ovrLoadResult := ovrLoadOk;
  307.   end { LoadOverlay } ;
  308.  
  309.   procedure UnloadOverlay(AnyRoutine : Pointer);
  310.     { Unload an overlay from the heap }
  311.   var
  312.     p, q : OverlayNodePtr;
  313.     spaceNeeded : LongInt;
  314.     pMemory : Pointer;
  315.   begin
  316.     p := Ptr(Seg(AnyRoutine^), 0);     { form overlay descriptor pointer }
  317.  
  318.     {$IFOPT O+}
  319.     if Seg(p^) = Seg(UnloadOverlay) then begin
  320.       ovrLoadResult := ovrLoadSelfErr;
  321.       Exit;
  322.     end { if } ;
  323.     {$ENDIF}
  324.     if p^.ovrInst <> $3FCD then begin  { not an overlay descriptor }
  325.       ovrLoadResult := ovrLoadNotOverlay;
  326.       Exit;
  327.     end { if } ;
  328.     if (p^.ovSegment = 0) or (p^.ovVectors[1].instr <> $EA)then begin
  329.       ovrLoadResult := ovrLoadNotLoaded;{ overlay is not in memory }
  330.       Exit;
  331.     end { if } ;
  332.     if p^.ovSaveReturn <> 0 then begin { waiting return to overlay }
  333.       ovrLoadResult := ovrLoadWaitRet;
  334.       Exit;
  335.     end { if } ;
  336.     if OvrLoadList <> 0 then begin     { search Overlay unit list of overlays }
  337.       q := Ptr(OvrLoadList, 0);        { point to list of loaded overlays }
  338.       repeat
  339.         if Seg(q^) = Seg(p^) then begin
  340.           ovrLoadResult := ovrLoadNotHeap;
  341.           Exit;
  342.         end { if } ;
  343.         q := Ptr(q^.ovNext, 0);
  344.       until q = nil;
  345.     end { if } ;
  346.     if p^.ovArea = nil then begin
  347.       ovrLoadResult := ovrLoadNotHeap;
  348.       Exit;
  349.     end { if } ;
  350.  
  351.     ovrBP := BPtr;                     { start stack search here }
  352.     ovVectorReturn(Seg(p^));           { patch ovVectors/stack returns }
  353.     p^.ovSegment := 0;                 { mark as unloaded }
  354.     FreeMem(p^.ovArea, ((p^.ovCodeSize+15) shr 4) shl 4 + Ofs(p^.ovArea^));
  355.     p^.ovArea := nil;
  356.     ovrLoadResult := ovrLoadOk;
  357.   end { UnloadOverlay } ;
  358.  
  359. end { OverlayHandler } .
  360.  
  361.